home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue65 / time / gptimezone.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-25  |  33.4 KB  |  932 lines
  1. {:      Primoz Gabrijelcic's Time Zone Routines v1.2<p>
  2.  
  3.         Date/Time Routines to enhance your 32-bit Delphi Programming. <p>
  4.  
  5.         (c) 1999, 2000 Primoz Gabrijelcic<p>
  6.  
  7.         =================================================== <p>
  8.         These routines are used by ESB Consultancy and Primoz Gabrijelcic
  9.         within the development of their Customised Application. <p>         Primoz Gabrijelcic retains full copyright. <p>
  10.         mailto:gabr@17slon.com
  11.         http://17slon.com/gp/gp/
  12.         http://www.eccentrica.org/gabr/gp/
  13.         http://members.xoom.com/primozg/gp/
  14.  
  15.         Primoz Gabrijelcic grants users of this code royalty free rights
  16.         to do with this code as they wish. <p>
  17.  
  18.         Primoz Gabrijelcic makes no guarantees nor excepts any liabilities
  19.         due to the use of these routines. <p>
  20.  
  21.         We do ask that if this code helps you in you development
  22.         that you send as an email mailto:info@esbconsult.com.au or even
  23.         a local postcard. It would also be nice if you gave us a
  24.         mention in your About Box, Help File or Documentation. <p>
  25.  
  26.         ESB Consultancy Home Page: http://www.esbconsult.com.au <p>
  27.  
  28.         Mail Address: PO Box 2259, Boulder, WA 6432 AUSTRALIA <p>
  29.  
  30.         See TestUTC for the Demo Program. (Note form may encounter minor
  31.         errors when opened with older versions of Delphi, simply ignore
  32.         them and all should be fine.)
  33.  
  34.         History:
  35.         <pre>
  36.         1.2: 2000-10-18
  37.           - String constant moved to resourcestring (D3 and newer) / const
  38.             (D2) section.
  39.           - Evaluation of "absolute date" format in
  40.             GetTZDaylightSavingInfoForYear and DSTDate2Date has changed. Those
  41.             two functions will return error (first 'false' and second '0') if
  42.             they are called with "absolute date" format time zone info and a
  43.             year which is not equal to the year in time zone info.
  44.  
  45.         1.1b: 2000-05-26
  46.           - Fixed another memory leak (a small one) in
  47.             TGpRegistryTimeZones.Clear.
  48.           
  49.         1.1a: 2000-05-18
  50.           - Fixed memory leak in TGpRegistryTimeZones.Clear (thanks to Adrian
  51.             Gallero who found it)
  52.  
  53.         1.1: 2000-02-11
  54.           - New class TGpRegistryTimeZones that allows read/write access to
  55.             timezone information in registry.
  56.           - GetTZCount and GetTZ are deprecated. Please use
  57.             TGpRegistryTimeZones.
  58.           - New function TimeZoneRegKey.
  59.  
  60.         1.0.2: 2000-01-12
  61.           - Modified FixDT to return input parameter if it does not represent a
  62.             valid date.
  63.  
  64.         1.0.1: 1999-10-22
  65.           - Function GetTZ was not working with Delphi 3. Fixed.
  66.           - Fixed rounding problems in UTCToSwatch and SwatchToUTC.
  67.           - Added function FixDT.
  68.  
  69.         1.0: 1999-10-18
  70.           - First official release.
  71.         </pre>
  72. }
  73.  
  74. unit GpTimezone;
  75.  
  76. interface
  77.  
  78. uses
  79.   Windows,
  80.   Classes;
  81.  
  82. const
  83.   MINUTESPERDAY = 1440;
  84.  
  85. type
  86.   TSwatchBeat = 0..999;
  87.  
  88.   TGpRegistryTimeZones = class;
  89.  
  90.   {: Encapsulates information about one timezone as stored in registry.
  91.      Modifying class properties may fail if write access to the registry
  92.      (HKEY_LOCAL_MACHINE + TimeZoneRegKey) is not allowed. In that property
  93.      Modified will return false but no exception will occur. }
  94.   TGpRegistryTimeZone = class
  95.   private
  96.     rtzDisplayName: string;
  97.     rtzEnglishName: string;
  98.     rtzModified   : boolean;
  99.     rtzOwner      : TGpRegistryTimeZones;
  100.     rtzRegistryKey: string;
  101.     rtzTimeZone   : TTimeZoneInformation;
  102.     function  GetWriteAccess: boolean;
  103.     procedure SetDisplayName(const Value: string);
  104.     procedure SetEnglishName(const Value: string);
  105.     procedure SetTimeZone(const Value: TTimeZoneInformation);
  106.     procedure SetWriteAccess(const Value: boolean);
  107.   protected
  108.     procedure SetOwner(AOwner: TGpRegistryTimeZones);
  109.     property RegistryKey: string read rtzRegistryKey write rtzRegistryKey;
  110.   public
  111.     property DisplayName: string read rtzDisplayName write SetDisplayName;
  112.     property EnglishName: string read rtzEnglishName write SetEnglishName;
  113.     property Modified: boolean read rtzModified;
  114.     property TimeZone: TTimeZoneInformation read rtzTimeZone write SetTimeZone;
  115.     property WriteAccess: boolean read GetWriteAccess write SetWriteAccess;
  116.   end; { TGpRegistryTimeZone }
  117.  
  118.   {: Encapsulates TimeZone information stored in registry. Allows read/write
  119.      access, addition and deletion of timezones. Use with care.
  120.      In fact, all modifications will trigger exception unless you set
  121.      'WriteAccess := true'. I just want to prevent you from accidentally
  122.      deleting half of your timezone settings (ouch!). }
  123.   TGpRegistryTimeZones = class
  124.   private
  125.     rtzList      : TList;
  126.     rtzFullAccess: boolean;
  127.     function  GetItem(idx: integer): TGpRegistryTimeZone;
  128.     procedure Clear;
  129.   protected
  130.     procedure CheckForWriteAccess;
  131.     function  Update(rtz: TGpRegistryTimeZone): boolean;
  132.   public
  133.     constructor Create;
  134.     destructor  Destroy; override;
  135.     function  Add(regTimeZone: TGpRegistryTimeZone): boolean;
  136.     function  Count: integer;
  137.     function  Delete(regTimeZone: TGpRegistryTimeZone): boolean;
  138.     procedure Reload;
  139.     property  Items[idx: integer]: TGpRegistryTimeZone read GetItem; default;
  140.     property  WriteAccess: boolean read rtzFullAccess write rtzFullAccess;
  141.   end; { TGpRegistryTimeZones }
  142.  
  143.   {: Returns true if date1 and date2 are almost the same (difference between
  144.      them is less than 1/10 of a millisecond. }
  145.   function DateEQ(date1, date2: TDateTime): boolean;
  146.  
  147.   {: Corrects date part so it will represent exact (as possible) millisecond,
  148.      not maybe small part before or after that. Useful when you want to use
  149.      Trunc/Int and Frac functions to get date or time part from TDateTime
  150.      variable.<br>
  151.      Example: FixDT(36463.99999999999) will return 36464.<br>
  152.      See function UTCToSwatch for another example.
  153.   }
  154.   function FixDT(date: TDateTime): TDateTime;
  155.  
  156.   {: Converts 'day of month' syntax to normal date. Set year and month to
  157.      required values, set weekInMonth to required week (1-4, or 5 for last),
  158.      set dayInWeek to required day of week (1 (Sunday) to 7 (Saturday) - Delphi
  159.      style).<br>
  160.      Example: To get last Sunday in Dec 1999 call DayOfMonth2Date(1999,12,5,0).}
  161.   function DayOfMonth2Date(year,month,weekInMonth,dayInWeek: word): TDateTime;
  162.  
  163.   {: Converts TIME_ZONE_INFORMATION date to normal date. Time zone information
  164.      can be returned in two formats by Windows API call GetTimeZoneInformation.
  165.      Absolute format specifies an exact date and time when standard/DS time
  166.      begins. In this form, the wYear, wMonth, wDay, wHour, wMinute , wSecond,
  167.      and wMilliseconds members of the TSystemTime structure are used to specify
  168.      an exact date. Year is left intact, if you want to change it, call
  169.      ESBDates.AdjustDateYear (warning: this will clear the time part).
  170.      Day-in-month format is specified by setting the wYear member to zero,
  171.      setting the wDayOfWeek member to an appropriate weekday (0 to 6,
  172.      0 = Sunday), and using a wDay value in the range 1 through 5 to select the
  173.      correct day in the month. Year parameter is used to specify year for this
  174.      date.
  175.      Returns 0 if 'dstDate' is invalid or if it specifies "absolute date" for a
  176.      year not equal to 'year' parameter. }
  177.   function DSTDate2Date(dstDate: TSystemTime; year: word): TDateTime;
  178.  
  179.   {: Returns daylight saving information for a specified time zone and year.
  180.      Sets DaylightDate and StandardDate year to specified year if date is
  181.      specified in day-in-month format (see above).<br>
  182.      DaylightDate and StandardDate are returned in local time. To convert them
  183.      to UTC use DaylightDate+StandardBias/MINUTESPERDAY and
  184.      StandardDate+DaylightBias/MINUTESPERDAY.<br>
  185.      Returns false if 'TZ' is invalid or if it specifies "absolute date" for a
  186.      year not equal to 'year' parameter. }
  187.   function GetTZDaylightSavingInfoForYear (
  188.     TZ: TTimeZoneInformation; year: word;
  189.     var DaylightDate, StandardDate: TDateTime;
  190.     var DaylightBias, StandardBias: longint): boolean;
  191.  
  192.   {: Returns daylight saving information for a specified time zone and current
  193.      year. See GetTZDaylightSavingInfoForYear for more information. }
  194.   function GetTZDaylightSavingInfo (TZ: TTimeZoneInformation;
  195.     var DaylightDate, StandardDate: TDateTime;
  196.     var DaylightBias, StandardBias: longint): boolean;
  197.  
  198.   {: Returns daylight saving information for current time zone and specified
  199.      year. See GetTZDaylightSavingInfoForYear for more information. }
  200.   function GetDaylightSavingInfoForYear (year: word;
  201.     var DaylightDate, StandardDate: TDateTime;
  202.     var DaylightBias, StandardBias: longint): boolean;
  203.  
  204.   {: Returns daylight saving information for current time zone and year. See
  205.      GetTZDaylightSavingInfoForYear for more information. }
  206.   function GetDaylightSavingInfo (var DaylightDate, StandardDate: TDateTime;
  207.     var DaylightBias, StandardBias: longint): boolean;
  208.  
  209.   {: Converts local time to UTC according to a given timezone rules. Takes into
  210.      account daylight saving time as it was active at that time. This is not
  211.      very safe as DST rules are always changing.<br>
  212.      Special processing is done for the times during the standard/daylight time
  213.      switch.
  214.      If the specified local time lies in the non-existing area (when clock is
  215.      moved forward), function returns 0.
  216.      If the specified local time lies in the ambigious area (when clock is moved
  217.      backward), function takes into account value of preferDST parameter. If it
  218.      is set to true, time is converted as if it belongs to the daylight time. If
  219.      it is set to false, time is converted as if it belong to the standard time.
  220.   }
  221.   function TZLocalTimeToUTC(TZ: TTimeZoneInformation; loctime: TDateTime;
  222.     preferDST: boolean): TDateTime;
  223.  
  224.   {: Converts local time to UTC according to a given timezone rules. Takes into
  225.      account daylight saving time as it was active at that time. This is not
  226.      very safe as DST rules are always changing.<br>
  227.      In Windows NT/2000 (but not in 95/98) you can use API function
  228.      SystemTimeToTzSpecificLocalTime instead. }
  229.   function UTCToTZLocalTime(TZ: TTimeZoneInformation; utctime: TDateTime): TDateTime;
  230.  
  231.   {: Converts local time to UTC according to a current time zone. See
  232.      TzLocalTimeToUTC for more information. }
  233.   function LocalTimeToUTC(loctime: TDateTime; preferDST: boolean): TDateTime;
  234.  
  235.   {: Converts UTC time to local time according toa current time zone. See
  236.      UTCToTZLocalTime for more information. }
  237.   function UTCToLocalTime(utctime: TDateTime): TDateTime;
  238.  
  239.   {: Returns number of all defined time zones.
  240.      @Deprecated Replaced with TGpRegistryTimeZones. }
  241.   function GetTZCount: integer;
  242.  
  243.   {: Returns data for idx-th (0..GetTZCount-1) time zone in TZ parameter.
  244.      Returns false if time zone does not exist.
  245.      @Deprecated Replaced with TGpRegistryTimeZones. }
  246.   function GetTZ(idx: integer; var EnglishName, displayName: string; var TZ: TTimeZoneInformation): boolean;
  247.  
  248.   {: Returns current bias (in minutes) for a given time zone. }
  249.   function GetTZBias(TZ: TTimeZoneInformation): longint;
  250.  
  251.   {: Returns current bias (in minutes) and UTC datetime for a given timezone. }
  252.   procedure GetTZNowUTCAndBias(TZ: TTimeZoneInformation; var nowUTC: TDateTime; var nowBias: integer);
  253.  
  254.   {: Returns current bias (in minutes) and UTC datetime. }
  255.   procedure GetNowUTCAndBias(var nowUTC: TDateTime; var nowBias: integer);
  256.  
  257.   {: Returns current UTC date and time. }
  258.   function NowUTC: TDateTime;
  259.  
  260.   {: Returns current UTC time. }
  261.   function TimeUTC: TDateTime;
  262.  
  263.   {: Returns current UTC date. }
  264.   function DateUTC: TDateTime;
  265.   
  266.   {: Compares two TSystemTime records. Returns -1 if st1 < st2, 1 is st1 > st2,
  267.      and 0 if st1 = st2. }
  268.   function CompareSysTime(st1, st2: TSystemTime): integer;
  269.  
  270.   {: Compares two TTimeZoneInformation records. }
  271.   function IsEqualTZ(tz1, tz2: TTimeZoneInformation): boolean;
  272.  
  273.   {: Converts UTC time to Swatch Internet Time. Date part is returned as
  274.      'internetDate' and beats part is returned as function result. } 
  275.   function UTCToSwatch(utctime: TDateTime; var internetDate: TDateTime): TSwatchBeat;
  276.  
  277.   {: Converts Swatch Internet Time to UTC time. }
  278.   function SwatchToUTC(internetDate: TDateTime; internetBeats: TSwatchBeat): TDateTime;
  279.  
  280.   {: Returns base key (relative to HKEY_LOCAL_MACHINE) for timezone settings. }
  281.   function TimeZoneRegKey: string;
  282.  
  283. implementation
  284.  
  285. uses
  286.   SysUtils,
  287.   Registry,
  288.   ESBDates;
  289.  
  290. var
  291.   G_RegistryTZ: TGpRegistryTimeZones; // used in GetTZCount, GetTZ
  292.  
  293. //There is no OpenKeyReadonly in Delphi 2 and 3. There is also no resourcestring in Delphi 2.
  294. {$UNDEF NeedBetterRegistry}
  295. {$UNDEF NoResourcestring}
  296. {$IFDEF VER90}
  297.   {$DEFINE NeedBetterRegistry}
  298.   {$DEFINE NoResourcestring}
  299. {$ENDIF}
  300. {$IFDEF VER100}
  301.   {$DEFINE NeedBetterRegistry}
  302. {$ENDIF VER100}
  303.  
  304. {$IFDEF NoResourcestring}
  305. const
  306. {$ELSE}
  307. resourcestring
  308. {$ENDIF}
  309.   sTGpRegistryTimeZonesWriteAccessNot = 'TGpRegistryTimeZones: WriteAccess not set.';
  310.  
  311. type
  312.   TBetterRegistry = class(TRegistry)
  313.   {$IFDEF NeedBetterRegistry}
  314.     function OpenKeyReadOnly(const Key: string): Boolean;
  315.   {$ENDIF NeedBetterRegistry}
  316.   end;
  317.  
  318. { TBetterRegistry }
  319.  
  320. {$IFDEF NeedBetterRegistry}
  321.   function IsRelative(const Value: string): boolean;
  322.   begin
  323.     Result := not ((Value <> '') and (Value[1] = '\'));
  324.   end;
  325.  
  326.   function TBetterRegistry.OpenKeyReadOnly(const Key: string): boolean;
  327.   var
  328.     TempKey : HKey;
  329.     S       : string;
  330.     Relative: boolean;
  331.   begin
  332.     S := Key;
  333.     Relative := IsRelative(S);
  334.     if not Relative then
  335.       Delete(S, 1, 1);
  336.     TempKey := 0;
  337.     Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
  338.         KEY_READ, TempKey) = ERROR_SUCCESS;
  339.     if Result then begin
  340.       if (CurrentKey <> 0) and Relative then
  341.         S := CurrentPath + '\' + S;
  342.       ChangeKey(TempKey, S);
  343.     end;
  344.   end; { TBetterRegistry.OpenKeyReadOnly }
  345. {$ENDIF NeedBetterRegistry}
  346.  
  347. { /TBetterRegistry }
  348.  
  349.   function DateEQ(date1, date2: TDateTime): boolean;
  350.   begin
  351.     Result := (Abs(date1-date2) < 1/(10*MSecsPerDay));
  352.   end; { DateEQ }
  353.  
  354.   function FixDT(date: TDateTime): TDateTime;
  355.   var
  356.     ye,mo,da,ho,mi,se,ms: word;
  357.   begin
  358.     try
  359.       DecodeDate(date,ye,mo,da);
  360.       DecodeTime(date,ho,mi,se,ms);
  361.       Result := EncodeDate(ye,mo,da)+EncodeTime(ho,mi,se,ms);
  362.     except
  363.       on E: EConvertError do Result := date;
  364.       else raise;
  365.     end;
  366.   end; { FixDT }
  367.  
  368.   function DayOfMonth2Date(year,month,weekInMonth,dayInWeek: word): TDateTime;
  369.   var
  370.     days: integer;
  371.     day : integer;
  372.   begin
  373.     if (weekInMonth >= 1) and (weekInMonth <= 4) then begin
  374.       day := DayOfWeek(EncodeDate(year,month,1));      // get first day in month
  375.       day := 1 + dayInWeek-day;                  // get first dayInWeek in month
  376.       if day <= 0 then
  377.         Inc(day,7);
  378.       day := day + 7*(weekInMonth-1);   // get weekInMonth-th dayInWeek in month
  379.       Result := EncodeDate(year,month,day);
  380.     end
  381.     else if weekInMonth = 5 then begin // last week, calculate from end of month
  382.       days := DaysInMonth(EncodeDate(year,month,1));
  383.       day  := DayOfWeek(EncodeDate(year,month,days));   // get last day in month
  384.       day  := days + (dayInWeek-day);
  385.       if day > days then
  386.         Dec(day,7);                               // get last dayInWeek in month
  387.       Result := EncodeDate(year,month,day);
  388.     end
  389.     else
  390.       Result := 0;
  391.   end; { DayOfMonth2Date }
  392.  
  393.   function DSTDate2Date(dstDate: TSystemTime; year: word): TDateTime;
  394.   begin
  395.     if dstDate.wMonth = 0 then
  396.       Result := 0                                // invalid month => no DST info
  397.     else if dstDate.wYear = 0 then begin                // day-of-month notation
  398.       Result :=
  399.         DayOfMonth2Date(year,dstDate.wMonth,dstDate.wDay,dstDate.wDayOfWeek+1{convert to Delphi Style}) +
  400.         EncodeTime(dstDate.wHour,dstDate.wMinute,dstDate.wSecond,dstDate.wMilliseconds);
  401.     end
  402.     else if dstDate.wYear = year then // absolute format - valid only for specified year
  403.       Result := SystemTimeToDateTime(dstDate)
  404.     else
  405.       Result := 0;
  406.   end; { DSTDate2Date }
  407.  
  408.   function GetTZDaylightSavingInfoForYear(
  409.     TZ: TTimeZoneInformation; year: word;
  410.     var DaylightDate, StandardDate: TDateTime;
  411.     var DaylightBias, StandardBias: longint): boolean;
  412.   begin
  413.     Result := false;
  414.     if (TZ.DaylightDate.wMonth <> 0) and
  415.        (TZ.StandardDate.wMonth <> 0) then
  416.     begin
  417.       DaylightDate := DSTDate2Date(TZ.DaylightDate,year);
  418.       StandardDate := DSTDate2Date(TZ.StandardDate,year);
  419.       DaylightBias := TZ.Bias+TZ.DaylightBias;
  420.       StandardBias := TZ.Bias+TZ.StandardBias;
  421.       Result := (DaylightDate <> 0) and (StandardDate <> 0);
  422.     end;
  423.   end; { GetTZDaylightSavingInfoForYear }
  424.  
  425.   function GetTZDaylightSavingInfo(TZ: TTimeZoneInformation;
  426.     var DaylightDate, StandardDate: TDateTime;
  427.     var DaylightBias, StandardBias: longint): boolean;
  428.   begin
  429.     Result := GetTZDaylightSavingInfoForYear(TZ,ThisYear,DaylightDate,StandardDate,DaylightBias,StandardBias);
  430.   end; { GetTZDaylightSavingInfo }
  431.  
  432.   function GetDaylightSavingInfoForYear(year: word;
  433.     var DaylightDate, StandardDate: TDateTime;
  434.     var DaylightBias, StandardBias: longint): boolean;
  435.   var
  436.     TZ: TTimeZoneInformation;
  437.   begin
  438.     GetTimeZoneInformation (TZ);
  439.     Result := GetTZDaylightSavingInfoForYear(TZ,year,DaylightDate,StandardDate,StandardBias,DaylightBias);
  440.   end; { GetDaylightSavingInfoForYear }
  441.  
  442.   function GetDaylightSavingInfo(var DaylightDate, StandardDate: TDateTime;
  443.     var DaylightBias, StandardBias: longint): boolean;
  444.   var
  445.     TZ: TTimeZoneInformation;
  446.   begin
  447.     GetTimeZoneInformation (TZ);
  448.     Result := GetTZDaylightSavingInfo(TZ,DaylightDate,StandardDate,StandardBias,DaylightBias);
  449.   end; { GetDaylightSavingInfo }
  450.  
  451.   function TZLocalTimeToUTC(TZ: TTimeZoneInformation; loctime: TDateTime;
  452.     preferDST: boolean): TDateTime;
  453.  
  454.     function Convert(startDate, endDate, startOverl, endOverl: TDateTime;
  455.       startInval, endInval: TDateTime; inBias, outBias, overlBias: longint): TDateTime;
  456.     begin
  457.       if ((locTime > startOverl) or DateEQ(locTime,startOverl)) and (locTime < endOverl) then
  458.         Result := loctime + overlBias/MINUTESPERDAY
  459.       else if ((locTime > startInval) or DateEQ(locTime,startInval)) and (locTime < endInval) then
  460.         Result := 0
  461.       else if ((locTime > startDate) or DateEQ(locTime,startDate)) and (locTime < endDate) then
  462.         Result := loctime + inBias/MINUTESPERDAY
  463.       else
  464.         Result := loctime + outBias/MINUTESPERDAY;
  465.     end; { Convert }
  466.  
  467.   var
  468.     dltBias : real;
  469.     overBias: longint;
  470.     stdBias : longint;
  471.     dayBias : longint;
  472.     stdDate : TDateTime;
  473.     dayDate : TDateTime;
  474.   begin { TZLocalTimeToUTC }
  475.     if GetTZDaylightSavingInfoForYear(TZ, Date2Year(loctime), dayDate, stdDate, dayBias, stdBias) then begin
  476.       if preferDST then
  477.         overBias := dayBias
  478.       else
  479.         overBias := stdBias;
  480.       dltBias := (stdBias-dayBias)/MINUTESPERDAY;
  481.       if dayDate < stdDate then begin // northern hemisphere
  482.         if dayBias < stdBias then // overlap at stdDate
  483.           Result := Convert(dayDate, stdDate, stdDate-dltBias, stdDate,
  484.             dayDate, dayDate+dltBias, dayBias, stdBias, overBias)
  485.         else // overlap at dayDate - that actually never happens
  486.           Result := Convert(dayDate, stdDate, dayDate+dltBias, dayDate,
  487.             stdDate, stdDate-dltBias, dayBias, stdBias, overBias);
  488.       end
  489.       else begin // southern hemisphere
  490.         if dayBias < stdBias then // overlap at stdDate
  491.           Result := Convert(stdDate, dayDate, stdDate-dltBias, stdDate,
  492.             dayDate, dayDate+dltBias, stdBias, dayBias, overBias)
  493.         else // overlap at dayDate - that actually never happens
  494.           Result := Convert(stdDate, dayDate, dayDate+dltBias, dayDate,
  495.             stdDate, stdDate-dltBias, stdBias, dayBias, overBias);
  496.       end;
  497.     end
  498.     else
  499.       Result := loctime + TZ.bias/MINUTESPERDAY; // TZ does not use DST
  500.   end; { TZLocalTimeToUTC }
  501.  
  502.   function UTCToTZLocalTime(TZ: TTimeZoneInformation; utctime: TDateTime): TDateTime;
  503.  
  504.     function Convert(startDate, endDate: TDateTime; inBias, outBias: longint): TDateTime;
  505.     begin
  506.       if ((utctime > startDate) or DateEQ(utctime,startDate)) and (utctime < endDate) then
  507.         Result := utctime - inBias/MINUTESPERDAY
  508.       else
  509.         Result := utctime - outBias/MINUTESPERDAY;
  510.     end; { Convert }
  511.  
  512.   var
  513.     stdUTC : TDateTime;
  514.     dayUTC : TDateTime;
  515.     stdBias: longint;
  516.     dayBias: longint;
  517.     stdDate: TDateTime;
  518.     dayDate: TDateTime;
  519.     
  520.   begin { UTCToTZLocalTime }
  521.     if GetTZDaylightSavingInfoForYear(TZ, Date2Year(utctime), dayDate, stdDate, dayBias, stdBias) then begin
  522.       dayUTC := dayDate + stdBias/MINUTESPERDAY;
  523.       stdUTC := stdDate + dayBias/MINUTESPERDAY;
  524.       if dayUTC < stdUTC then
  525.         Result := Convert(dayUTC,stdUTC,dayBias,stdBias)  // northern hem.
  526.       else
  527.         Result := Convert(stdUTC,dayUTC,stdBias,dayBias); // southern hem.
  528.     end
  529.     else
  530.       Result := utctime - TZ.bias/MINUTESPERDAY; // TZ does not use DST
  531.   end; { UTCToTZLocalTime }
  532.  
  533.   function LocalTimeToUTC(loctime: TDateTime; preferDST: boolean): TDateTime;
  534.   var
  535.     TZ: TTimeZoneInformation;
  536.   begin
  537.     GetTimeZoneInformation (TZ);
  538.     Result := TZLocalTimeToUTC(TZ,loctime,preferDST);
  539.   end; { LocalTimeToUTC }
  540.  
  541.   function UTCToLocalTime(utctime: TDateTime): TDateTime;
  542.   var
  543.     TZ: TTimeZoneInformation;
  544.   begin
  545.     GetTimeZoneInformation (TZ);
  546.     Result := UTCToTZLocalTime(TZ,utctime);
  547.   end; { UTCToLocalTime }
  548.  
  549.   function CompareSysTime(st1, st2: TSystemTime): integer;
  550.   begin
  551.     if st1.wYear < st2.wYear then
  552.       Result := -1
  553.     else if st1.wYear > st2.wYear then
  554.       Result := 1
  555.     else if st1.wMonth < st2.wMonth then
  556.       Result := -1
  557.     else if st1.wMonth > st2.wMonth then
  558.       Result := 1
  559.     else if st1.wDayOfWeek < st2.wDayOfWeek then
  560.       Result := -1
  561.     else if st1.wDayOfWeek > st2.wDayOfWeek then
  562.       Result := 1
  563.     else if st1.wDay < st2.wDay then
  564.       Result := -1
  565.     else if st1.wDay > st2.wDay then
  566.       Result := 1
  567.     else if st1.wHour < st2.wHour then
  568.       Result := -1
  569.     else if st1.wHour > st2.wHour then
  570.       Result := 1
  571.     else if st1.wMinute < st2.wMinute then
  572.       Result := -1
  573.     else if st1.wMinute > st2.wMinute then
  574.       Result := 1
  575.     else if st1.wSecond < st2.wSecond then
  576.       Result := -1
  577.     else if st1.wSecond > st2.wSecond then
  578.       Result := 1
  579.     else if st1.wMilliseconds < st2.wMilliseconds then
  580.       Result := -1
  581.     else if st1.wMilliseconds > st2.wMilliseconds then
  582.       Result := 1
  583.     else
  584.       Result := 0;
  585.   end; { CompareSysTime }
  586.   
  587.   function IsEqualTZ(tz1, tz2: TTimeZoneInformation): boolean;
  588.   begin
  589.     Result :=
  590.       (tz1.Bias         = tz2.Bias)         and
  591.       (tz1.StandardBias = tz2.StandardBias) and
  592.       (tz1.DaylightBias = tz2.DaylightBias) and
  593.       (CompareSysTime(tz1.StandardDate,tz2.StandardDate) = 0) and
  594.       (CompareSysTime(tz1.DaylightDate,tz2.DaylightDate) = 0) and
  595.       (WideCharToString(tz1.StandardName) = WideCharToString(tz2.StandardName)) and
  596.       (WideCharToString(tz1.DaylightName) = WideCharToString(tz2.DaylightName));
  597.   end; { IsEqualTZ }
  598.  
  599.   // Following two functions are converting Swatch Internet Time to UTC. Swatch
  600.   // time is equal to GMT+1 (without DST) except that time portion is specified
  601.   // as integer in the range of 0..999.
  602.  
  603.   function UTCToSwatch(utctime: TDateTime; var internetDate: TDateTime): TSwatchBeat;
  604.   begin
  605.     utctime := FixDT(utctime+60/MINUTESPERDAY);
  606.     internetDate := Trunc(utctime);
  607.     Result := Round(Frac(utctime)*(High(TSwatchBeat)+1));
  608.   end; { UTCToSwatch }
  609.  
  610.   function SwatchToUTC(internetDate: TDateTime; internetBeats: TSwatchBeat): TDateTime;
  611.   begin
  612.     Result := FixDT(Trunc(FixDT(internetDate))+(internetBeats/(High(TSwatchBeat)+1))-60/MINUTESPERDAY);
  613.   end; { SwatchToUTC }
  614.  
  615.   function GetTZCount: integer;
  616.   begin
  617.     Result := G_RegistryTZ.Count;
  618.   end; { GetTZCount }
  619.  
  620.   function GetTZ(idx: integer; var EnglishName, displayName: string; var TZ: TTimeZoneInformation): boolean;
  621.   var
  622.     rtz: TGpRegistryTimeZone;
  623.   begin
  624.     if (idx >= 0) and (idx < GetTZCount) then begin
  625.       rtz := G_RegistryTZ[idx];
  626.       EnglishName := rtz.EnglishName;
  627.       DisplayName := rtz.DisplayName;
  628.       TZ := rtz.TimeZone;
  629.       Result := true;
  630.     end
  631.     else
  632.       Result := false;
  633.   end; { GetTZ }
  634.   
  635.   function GetTZBias(TZ: TTimeZoneInformation): longint;
  636.   var
  637.     nowUTC: TDateTime;
  638.   begin
  639.     GetTZNowUTCAndBias(TZ,nowUTC,Result);
  640.   end; { GetTZBias }
  641.  
  642.   procedure GetTZNowUTCAndBias(TZ: TTimeZoneInformation; var nowUTC: TDateTime; var nowBias: integer);
  643.   var
  644.     biasStart: longint;
  645.     sysnow   : TSystemTime;
  646.     tznow    : TDateTime;
  647.   begin
  648.     repeat
  649.       biasStart := GetLocalTZBias;
  650.       GetSystemTime(sysnow);
  651.       nowUTC  := SystemTimeToDateTime(sysnow);
  652.       tznow   := UTCToTZLocalTime(TZ,nowUTC);
  653.       nowBias := Round((nowUTC-tznow)*MINUTESPERDAY);
  654.     until biasStart = GetLocalTZBias; // recalc if local bias changed in the middle of calculation
  655.   end; { GetTZNowUTCAndBias }
  656.  
  657.   procedure GetNowUTCAndBias(var nowUTC: TDateTime; var nowBias: integer);
  658.   var
  659.     TZ: TTimeZoneInformation;
  660.   begin
  661.     GetTimeZoneInformation (TZ);
  662.     GetTZNowUTCAndBias(TZ, nowUTC, nowBias);
  663.   end; { TBetterRegistry.GetNowUTCAndBias }
  664.  
  665.   function NowUTC: TDateTime;
  666.   var
  667.     sysnow: TSystemTime;
  668.   begin
  669.     GetSystemTime(sysnow);
  670.     Result := SystemTimeToDateTime(sysnow);
  671.   end; { NowUTC }
  672.  
  673.   function TimeUTC: TDateTime;
  674.   begin
  675.     Result := Frac(NowUTC);
  676.   end; { TimeUTC }
  677.  
  678.   function DateUTC: TDateTime;
  679.   begin
  680.     Result := Int(NowUTC);
  681.   end; { DateUTC }
  682.  
  683.   function TimeZoneRegKey: string;
  684.   begin
  685.     if Win32Platform = VER_PLATFORM_WIN32_NT then
  686.       Result := '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones'
  687.     else
  688.       Result := '\SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones';
  689.   end; { TimeZoneRegKey }
  690.  
  691. { private }
  692.  
  693.   type
  694.     TRegTZI = packed record
  695.       Bias: Longint;
  696.       StandardBias: Longint;
  697.       DaylightBias: Longint;
  698.       StandardDate: TSystemTime;
  699.       DaylightDate: TSystemTime;
  700.     end;
  701.  
  702.   function GetTZFromRegistry(reg: TBetterRegistry; var displayName: string; var TZ: TTimeZoneInformation): boolean;
  703.   var
  704.     regTZI: TRegTZI;
  705.   begin
  706.     Result := false;
  707.     if assigned(reg) then begin
  708.       with reg do begin
  709.         if GetDataSize('TZI') = SizeOf(regTZI) then begin // data in correct format - hope, hope
  710.           displayName := ReadString('Display');
  711.           StringToWideChar(ReadString('Std'),@TZ.StandardName,SizeOf(TZ.StandardName) div SizeOf(WideChar));
  712.           StringToWideChar(ReadString('Dlt'),@TZ.DaylightName,SizeOf(TZ.DaylightName) div SizeOf(WideChar));
  713.           ReadBinaryData('TZI',regTZI,SizeOf(regTZI));
  714.           TZ.Bias := regTZI.Bias;
  715.           TZ.StandardBias := regTZI.StandardBias;
  716.           TZ.DaylightBias := regTZI.DaylightBias;
  717.           TZ.StandardDate := regTZI.StandardDate;
  718.           TZ.DaylightDate := regTZI.DaylightDate;
  719.           Result := true;
  720.         end;
  721.       end; //with
  722.     end;
  723.   end; { GetTZFromRegistry }
  724.  
  725.   function PutTZToRegistry(reg: TBetterRegistry; displayName: string; TZ: TTimeZoneInformation): boolean;
  726.   var
  727.     regTZI: TRegTZI;
  728.   begin
  729.     Result := false;
  730.     if assigned(reg) then begin
  731.       with reg do begin
  732.         WriteString('Display',displayName);
  733.         WriteString('Std',TZ.StandardName);
  734.         WriteString('Dlt',TZ.DaylightName);
  735.         regTZI.Bias := TZ.Bias;
  736.         regTZI.StandardBias := TZ.StandardBias;
  737.         regTZI.DaylightBias := TZ.DaylightBias;
  738.         regTZI.StandardDate := TZ.StandardDate;
  739.         regTZI.DaylightDate := TZ.DaylightDate;
  740.         WriteBinaryData('TZI',regTZI,SizeOf(regTZI));
  741.         Result := true;
  742.       end; //with
  743.     end;
  744.   end; { PutTZToRegistry }
  745.  
  746. { TGpRegistryTimeZones }
  747.  
  748.   function TGpRegistryTimeZones.Add(
  749.      regTimeZone: TGpRegistryTimeZone): boolean;
  750.   var
  751.     reg: TBetterRegistry;
  752.   begin
  753.     CheckForWriteAccess;
  754.     Result := false;
  755.     reg := TBetterRegistry.Create;
  756.     with reg do try
  757.       RootKey := HKEY_LOCAL_MACHINE;
  758.       regTimeZone.RegistryKey := regTimeZone.EnglishName;
  759.       if OpenKey(TimeZoneRegKey+'\'+regTimeZone.RegistryKey,true) then begin
  760.         PutTZToRegistry(reg,regTimeZone.DisplayName,regTimeZone.TimeZone);
  761.         CloseKey;
  762.         Result := true;
  763.       end;
  764.     finally reg.Free; end; //with
  765.   end; { TGpRegistryTimeZones.Add }
  766.  
  767.   procedure TGpRegistryTimeZones.CheckForWriteAccess;
  768.   begin
  769.     if not WriteAccess then
  770.       raise Exception.Create(sTGpRegistryTimeZonesWriteAccessNot);
  771.   end; { TGpRegistryTimeZones.CheckForWriteAccess }
  772.  
  773.   procedure TGpRegistryTimeZones.Clear;
  774.   var
  775.     i: integer;
  776.   begin
  777.     for i := 0 to rtzList.Count-1 do begin
  778.       TGpRegistryTimeZone(rtzList[i]).Free;
  779.       rtzList[i] := nil;
  780.     end; //for
  781.     rtzList.Clear;
  782.   end; { TGpRegistryTimeZones.Clear }
  783.  
  784.   function TGpRegistryTimeZones.Count: integer;
  785.   begin
  786.     Result := rtzList.Count;
  787.   end; { TGpRegistryTimeZones.Count }
  788.  
  789.   constructor TGpRegistryTimeZones.Create;
  790.   begin
  791.     rtzList := TList.Create;
  792.     Reload;
  793.   end; { TGpRegistryTimeZones.Create }
  794.  
  795.   function TGpRegistryTimeZones.Delete(
  796.     regTimeZone: TGpRegistryTimeZone): boolean;
  797.   begin
  798.     CheckForWriteAccess;
  799.     with TBetterRegistry.Create do try
  800.       RootKey := HKEY_LOCAL_MACHINE;
  801.       Result := DeleteKey(TimeZoneRegKey+'\'+regTimeZone.RegistryKey);
  802.     finally {self.}Free; end; //with
  803.   end; { TGpRegistryTimeZones.Delete }
  804.   
  805.   destructor TGpRegistryTimeZones.Destroy;
  806.   begin
  807.     Clear;
  808.     rtzList.Free;
  809.     inherited Destroy;
  810.   end; { TGpRegistryTimeZones.Destroy }
  811.  
  812.   function TGpRegistryTimeZones.GetItem(idx: integer): TGpRegistryTimeZone;
  813.   begin
  814.     Result := rtzList[idx];
  815.   end; { TGpRegistryTimeZones.GetItem }
  816.  
  817.   procedure TGpRegistryTimeZones.Reload;
  818.   var
  819.     TZ  : TTimeZoneInformation;
  820.     i   : integer;
  821.     reg : TBetterRegistry;
  822.     rtz : TGpRegistryTimeZone;
  823.     disp: string;
  824.     keys: TStringList;
  825.   begin
  826.     Clear;
  827.     reg := TBetterRegistry.Create;
  828.     with reg do try
  829.       RootKey := HKEY_LOCAL_MACHINE;
  830.       if OpenKeyReadOnly(TimeZoneRegKey) then begin
  831.         keys := TStringList.Create;
  832.         try
  833.           GetKeyNames(keys);
  834.           for i := 0 to keys.Count-1 do begin
  835.             if OpenKeyReadOnly(TimeZoneRegKey+'\'+keys[i]) then begin
  836.               if GetTzFromRegistry(reg,disp,TZ) then begin
  837.                 rtz := TGpRegistryTimeZone.Create;
  838.                 rtz.TimeZone := TZ;
  839.                 rtz.EnglishName := keys[i];
  840.                 rtz.DisplayName := disp;
  841.                 rtz.RegistryKey := keys[i];
  842.                 rtzList.Add(rtz);
  843.                 rtz.SetOwner(self);
  844.               end;
  845.               CloseKey;
  846.             end;
  847.           end; //for
  848.         finally keys.Free; end;
  849.       end;
  850.     finally reg.Free; end; //with
  851.   end; { TGpRegistryTimeZones.Reload }
  852.  
  853.   function TGpRegistryTimeZones.Update(rtz: TGpRegistryTimeZone): boolean;
  854.   var
  855.     reg: TBetterRegistry;
  856.   begin
  857.     CheckForWriteAccess;
  858.     reg := TBetterRegistry.Create;
  859.     with reg do try
  860.       RootKey := HKEY_LOCAL_MACHINE;
  861.       if AnsiCompareText(rtz.RegistryKey,rtz.EnglishName) <> 0 then begin
  862.         MoveKey(TimeZoneRegKey+'\'+rtz.RegistryKey,
  863.           TimeZoneRegKey+'\'+rtz.EnglishName,true);
  864.         rtz.RegistryKey := rtz.EnglishName;
  865.       end;
  866.       Result := Add(rtz);
  867.     finally {self.}Free; end; //with
  868.   end; { TGpRegistryTimeZones.Update }
  869.  
  870. { TGpRegistryTimeZone }
  871.  
  872.   function TGpRegistryTimeZone.GetWriteAccess: boolean;
  873.   begin
  874.     if assigned(rtzOwner) then
  875.       Result := rtzOwner.WriteAccess
  876.     else
  877.       Result := true;
  878.   end; { TGpRegistryTimeZone. }
  879.  
  880.   procedure TGpRegistryTimeZone.SetDisplayName(const Value: string);
  881.   begin
  882.     rtzModified := true;
  883.     if Value <> rtzDisplayName then begin
  884.       rtzDisplayName := Value;
  885.       if assigned(rtzOwner) then
  886.         if not rtzOwner.Update(self) then
  887.           rtzModified := false;
  888.     end;
  889.   end; { TGpRegistryTimeZone.SetDisplayName }
  890.  
  891.   procedure TGpRegistryTimeZone.SetEnglishName(const Value: string);
  892.   begin
  893.     rtzModified := true;
  894.     if Value <> rtzEnglishName then begin
  895.       rtzEnglishName := Value;
  896.       if assigned(rtzOwner) then
  897.         if not rtzOwner.Update(self) then
  898.           rtzModified := false;
  899.     end;
  900.   end; { TGpRegistryTimeZone.SetEnglishName }
  901.  
  902.   procedure TGpRegistryTimeZone.SetOwner(AOwner: TGpRegistryTimeZones);
  903.   begin
  904.     rtzOwner := AOwner;
  905.   end; { TGpRegistryTimeZone.SetOwner }
  906.  
  907.   procedure TGpRegistryTimeZone.SetTimeZone(
  908.     const Value: TTimeZoneInformation);
  909.   begin
  910.     rtzModified := true;
  911.     if not IsEqualTZ(Value,rtzTimeZone) then begin
  912.       rtzTimeZone := Value;
  913.       if assigned(rtzOwner) then
  914.         if not rtzOwner.Update(self) then
  915.           rtzModified := false;
  916.     end;
  917.   end; { TGpRegistryTimeZone.SetTimeZone }
  918.   
  919.   procedure TGpRegistryTimeZone.SetWriteAccess(const Value: boolean);
  920.   begin
  921.     if assigned(rtzOwner) then
  922.       rtzOwner.WriteAccess := Value;
  923.   end; { TGpRegistryTimeZone.SetWriteAccess }
  924.  
  925. initialization
  926.   G_RegistryTZ := TGpRegistryTimeZones.Create;
  927. finalization
  928.   G_RegistryTZ.Free;
  929.   G_RegistryTZ := nil;
  930. end.
  931.  
  932.